Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/ISSUE09/CODERS/EXPTTOOL.PAS

Pascal/Delphi Source File | 1996-03-20 | 5.6 KB | 220 lines

unit ExptTool ;
(*****) interface (*******************************)
uses
  WinTypes,
  winProcs,
  Messages,
  SysUtils,
  Classes,
  KeyDefs ;


type
  TTitleBuffer = array [0..127] of char ;

  TIconListRec = class
    TheIcon : HIcon ;
    TheWindow : HWnd ;
  end ;

function FindChild( WindowName, ChildName : string ) : HWnd ;
Function GetEditControl : HWnd;

procedure ListWindowTitles( Start : HWnd ; var WndList : TStringList ) ;
procedure ListTopLevelWindows( Start : HWnd ; var WndList : TStringList ) ;
function FindPartialWindowTitle( Title : string ) : HWnd ;
function StayOnTop( Wnd : HWnd ) : boolean ;
function NoStayOnTop( Wnd : HWnd ) : boolean ;

function SendKeys( S : string ) : TSendKeyError ;
procedure TileChildWindows( Wnd : HWnd ; Flags : bool ) ;
procedure CascadeChildWindows( Wnd : HWnd ; Flags : bool ) ;
procedure SwitchToThisWindow( Wnd : HWnd ; Flags : bool ) ;
function IsWinOldApTask( Task : THandle ) : boolean ;

(*****) implementation (**************************)

procedure ListWindowTitles( Start : HWnd ; var WndList : TStringList ) ;
var
  Wnd : HWnd ;
  Buff : TTitleBuffer ;
begin
  Wnd := GetWindow( Start, GW_CHILD ) ;
  while Wnd > 0 do
  begin
    if
    (* window is visible *)
      ( IsWindowVisible( Wnd ))
    and
    (* window has non-null title *)
      ( GetWindowText( Wnd, buff, SizeOf( buff )) > 0 )
    then
      WndList.Add( StrPas( buff )) ;
    Wnd := GetWindow( Wnd, GW_HWNDNEXT ) ;
  end ;
end ;

procedure ListTopLevelWindows( Start : HWnd ; var WndList : TStringList ) ;
var
  Wnd : HWnd ;
  Buff : TTitleBuffer ;
begin
  Wnd := GetWindow( Start, GW_HWNDFIRST ) ;
  while Wnd <> 0 do
  begin
    if
    (* window is visible *)
      ( IsWindowVisible( Wnd ))
    and
    (* window is "top level" (owner is Desktop window ) *)
      ( GetWindow( Wnd, GW_OWNER ) = 0 )
    and
    (* window has non-null title *)
      ( GetWindowText( Wnd, buff, SizeOf( buff )) > 0 )
    then
      WndList.Add( StrPas( buff )) ;
    Wnd := GetWindow( Wnd, GW_HWNDNEXT ) ;
  end ;
end ;

function StayOnTop( Wnd : HWnd ) : boolean ;
begin
  Result := FALSE ;
  if IsWindow( Wnd ) then
  begin
   SetWindowPos( Wnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE ) ;
   Result := TRUE ;
  end ;
end ;

function NoStayOnTop( Wnd : HWnd ) : boolean ;
begin
  Result := FALSE ;
  if IsWindow( Wnd ) then
  begin
   SetWindowPos( Wnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE ) ;
   Result := TRUE ;
  end ;
end ;

{
function FindPartialWindowTitle( Title : string ) : HWnd ;
var
  Wnd : HWnd ;
  TitleBuff : TTitleBuffer ;
begin
  Result := 0 ;
  Wnd := GetWindow( GetDesktopWindow, GW_CHILD ) ;
  while ( Wnd <> 0 ) do
  begin
    GetWindowText( Wnd, TitleBuff, SizeOf( TitleBuff )) ;
    if Pos( UpperCase( Title ), UpperCase( StrPas( TitleBuff ))) > 0 then
    begin
      Result := Wnd ;
      Exit ;
    end ;
    Wnd := GetWindow( Wnd, GW_HWNDNEXT ) ;
  end ;
end ;
}

function FindPartialWindowTitle( Title : string ) : HWnd ;
var
  Titles : TStringList ;
  i : integer ;
  Found : boolean ;
  TitleBuff : TTitleBuffer ;
begin
  Result := 0 ;
  Titles := TStringList.Create ;
  Titles.Clear ;

  ListWindowTitles( GetDesktopWindow, Titles ) ;

  i := 0 ;
  Found := FALSE ;
  while ( i <= Titles.Count - 1 ) and ( not Found ) do
  begin
    if Pos( UpperCase( Title ), UpperCase( Titles[i] )) > 0 then
    begin
      Found := TRUE ;
      Result := FindWindow( nil, StrPCopy( TitleBuff, Titles[i] )) ;
    end
    else
      Inc( i ) ;
  end ;

  Titles.Free ;
end ;

Function GetEditControl : HWnd;
Var
   Wnd : HWND;
   Name : Array[0..32] Of Char;
Begin
   Wnd := GetWindow(FindWindow('TEditWindow', Nil), GW_CHILD);
   While Wnd <> 0 Do
      Begin
         GetClassName(Wnd, Name, 32);
         If StrComp(Name, 'TEditControl') = 0 Then
            Begin
               GetEditControl := Wnd;
               Exit;
            End;
         Wnd := GetWindow(Wnd, GW_HWNDNEXT);
      End;
   GetEditControl := 0;
   MessageBox( 0, 'Window not found', 'Error', MB_OK ) ;
End;

function FindChild( WindowName, ChildName : string ) : HWnd ;
var
  Wnd  : HWnd ;
  TempBuff    : array[0..32] Of char ;
  WindowBuff, ChildBuff : TTitleBuffer ;
begin
  Result := 0 ;
  StrPCopy( WindowBuff, WindowName ) ;
  StrPCopy( ChildBuff, ChildName ) ;

  (* find parent window handle from classname *)
  (* then get first child window handle *)
  Wnd := GetWindow( FindWindow( WindowBuff, nil ), GW_CHILD) ;

  while Wnd <> 0 do  (* GetWindow returns 0 when no more windows to iterate *)
  begin
    (* get classname of child winodow *)
    GetClassName( Wnd, TempBuff, 32 ) ;


    if StrComp( TempBuff, ChildBuff ) <> 0 then
    (* if obtained class name <> desired one then get next child window *)
      Wnd := GetWindow( Wnd, GW_HWNDNEXT )

    else
    begin
      (* return found child window handle *)
      Result := Wnd ;
      Exit ;
    end;
  end;
end;

function SendKeys( S : string ) : TSendKeyError ; external 'SKEYS' ;
procedure TileChildWindows( Wnd : HWnd ; Flags : bool ) ; external 'USER' ;
procedure CascadeChildWindows( Wnd : HWnd ; Flags : bool ) ; external 'USER' ;
procedure SwitchToThisWindow( Wnd : HWnd ; Flags : bool ) ; external 'USER' ;
function IsWinOldApTask( Task : THandle ) : boolean ; external 'KERNEL' ;

{$ifdef VER80}
initialization
{$else}
begin
{$endif}
    (* unit ExptTool -- initialization code *)
  (* NONE *)
end (* unit ExptTool -- initialization code *) .